module Hex = (*{{{*)
struct
  value width = 48;
  value height = 23;
  value offset = 5;
  value wcenter = width / 2;
  value cheight = 13;
  value hnormal = cheight + offset;
end;(*}}}*)

(*{{{ Window Params *)
value win_width = ref 1200;
value win_height = ref 800;
value win_title = ("Черновой черновик [SDL based]","HellHole");
value win_icon_filename = "sites/docroot/favicon.png";

value bg_image_filename = "sites/docroot/items/bazuka_ammo.png";
value font_filename  = "/usr/share/fonts/thaifonts-scalable/Loma.ttf";
(*}}}*)

value f_width = Hex.width*64; 
value f_height = 64*Hex.hnormal; 
value f_wcenter=f_width/2;
value f_hcenter=f_height/2;

value (min_s_x,min_s_y) = (0,0);
value (max_s_x,max_s_y) = (f_width-win_width.val,f_height-win_height.val);
value scroll_offset = ref (0,0);


value initScreen () =
  (
    Sdlgl.set_attr [ Sdlgl.DEPTH_SIZE 16; Sdlgl.DOUBLEBUFFER True];
    ignore(Sdlvideo.set_video_mode win_width.val win_height.val [`OPENGL; `RESIZABLE]);
    let icon   = Sdlloader.load_image win_icon_filename in
    (

      Sdlwm.set_caption (fst win_title) (snd win_title);      
      Sdlwm.set_icon icon;
      Log.d  "DRIVER: %s" (Sdlvideo.driver_name ());
      let test v = if v then "ЕСТЬ" else "НЕТ" in
      let vi = Sdlvideo.get_video_info () in
      (
        print_endline ("Аппаратная поддержка сурфейсов:      [" ^ (test vi.Sdlvideo.hw_available) ^ "]" );
        print_endline ("Менеджер окон:                       [" ^ (test vi.Sdlvideo.wm_available) ^ "]" );
        print_endline ("Ускоренная отрисовка HW -> HW:       [" ^ (test vi.Sdlvideo.blit_hw) ^ "]" );
        print_endline ("Ускоренная отрисовка HW с color_key: [" ^ (test vi.Sdlvideo.blit_hw_color_key) ^ "]" );
        print_endline ("Ускоренная отрисовка HW с альфой:    [" ^ (test vi.Sdlvideo.blit_hw_alpha) ^ "]" );
        print_endline ("Ускоренная отрисовка SW -> HW:       [" ^ (test vi.Sdlvideo.blit_sw) ^ "]" );
        print_endline ("Ускоренная отрисовка SW с color_key: [" ^ (test vi.Sdlvideo.blit_sw_color_key) ^ "]" );
        print_endline ("Ускоренная отрисовка SW с альфой:    [" ^ (test vi.Sdlvideo.blit_sw_alpha) ^ "]" );
        print_endline ("Ускоренная залика цветом:            [" ^ (test vi.Sdlvideo.blit_fill) ^ "]" );
        print_endline ("Доступно видео памяти:               [" ^ (string_of_int vi.Sdlvideo.video_mem) ^ "]" );
      );

      GlClear.color (44.0 /. 255.0 , 84.0 /. 255.0, 47.0 /. 255.0) ~alpha:1.0;

       Gl.enable `depth_test; 
      GlFunc.depth_func `lequal;


      (* устанавливаем вьюпорт в размерах нашего экрана *)
      GlDraw.viewport ~x:(fst scroll_offset.val) ~y:(snd scroll_offset.val) ~w:win_width.val ~h:win_height.val;

      (* Устанавливаем ортогональное проецирование *)
      GlMat.mode `projection;
      GlMat.load_identity ();

      GlMat.ortho 
        ~x:(0.0,float_of_int win_width.val)
        ~y:(float_of_int win_height.val,0.0)
        ~z:(-.1., 1.);

      (* возвращаемся к модельвью из проекции *)
      GlMat.mode `modelview;
      GlMat.load_identity ();
    );
  );
(*}}}*)


(* {{{ Преобразование хек-экран *)
value dy (y:int) = if y<0 then y/2 + y mod 2 else y/2;
value array_of_hex (x,y) =
 let shift_x = x + 66/2  in
 let shift_y = y + 66/2 in
  (shift_x + dy y, shift_y);

value g_of_hex (x,y) =   
  let gx = Hex.width*x+(if y mod 2 = 0 then Hex.wcenter else 0) in
  let gy = y*Hex.hnormal in
  (gx,gy); (* }}} *)

value (_ground: ref (GlPix.t  [=`rgba] [=`ubyte] )) = ref (GlPix.create `ubyte `rgba 1 1);

type static_object = {
  glpix: GlPix.t  [=`rgba] [=`ubyte];
  pos_x: float;
  pos_y: float;
  z_index:float;
};

value (_objects: ref (list static_object)) = ref [];

value draw_ground () = 
  (
    GlPix.raster_pos ~x:0. ~y:0. ~z:1. ();
    GlPix.zoom 1. ~-.1.;
    GlPix.draw (_ground.val);
  );
  
value draw_objects () = 
  (
    GlPix.zoom 1. ~-.1.;
    List.iter begin fun obj ->
    (
      GlPix.raster_pos ~x:obj.pos_x ~y:obj.pos_y ~z: obj.z_index ();
      GlPix.draw obj.glpix
    )
    end (List.rev _objects.val)
  );

value draw_actors () = 
  (
  );



value render () = 
  (
    GlClear.clear [`color; `depth]; 



(*     Gl.enable `depth_test;  *)
(*     Gl.disable `depth_test;  *)

    draw_ground ();
    draw_objects ();

    GlDraw.viewport ~x:~-(fst scroll_offset.val) ~y:(snd scroll_offset.val) ~w:win_width.val ~h:win_height.val;

    Sdlgl.swap_buffers ();
  );

value initGround hex_w hex_h tiles objects = 
  let w = hex_w*Hex.width in
  let h = hex_h*Hex.hnormal in
  let sdl_ground = 
    Sdlvideo.create_RGB_surface 
      [`HWSURFACE;`ASYNCBLIT;`SRCALPHA] ~w ~h ~bpp:32
      ~rmask:0x000000ffl 
      ~gmask:0x0000ff00l 
      ~bmask:0x00ff0000l 
      ~amask:0xffffffffl 
  in
  let join_resource (x,y,zindex,imgs) flag = 
    let (x,y) = array_of_hex (x,y) in
    let (pos_x,pos_y) = g_of_hex (x,y) in
      List.iter begin fun (hot_x,hot_y,image) ->
        let img_info = Sdlvideo.surface_info image in
        let (iw,ih) = (img_info.Sdlvideo.w,img_info.Sdlvideo.h) in
        let (real_x,real_y) = ((pos_x-hot_x),(pos_y-hot_y)) in
          match flag with
          [ `Tile ->
             Sdlvideo.blit_surface ~src:image ~dst:sdl_ground ~dst_rect:( Sdlvideo.rect real_x real_y iw ih ) ()
          | `Object ->
             let image = Sdlvideo.display_format ~alpha:True image in
             let raw = Sdlgl.to_raw image in
             let pix = GlPix.of_raw raw ~format:`rgba ~width:iw ~height:ih in
             let obj = 
               {
                 glpix = pix; 
                 pos_x = float real_x;
                 pos_y = float real_y;
                 z_index = float zindex 
               }
             in
             _objects.val := [ obj :: _objects.val ]
          ]
      end imgs
  in
  (
    List.iter (fun t -> join_resource t `Tile) tiles;
    List.iter (fun t -> join_resource t `Tile) objects;
    let raw = Sdlgl.to_raw sdl_ground in
    (
      _ground.val := GlPix.of_raw raw ~format:`rgba ~width:w ~height:h;
      render ();
    )
  );


value resource_name id = 
  Printf.sprintf "sites/docroot/locitems2/%d.hhr" id;

value load_resource file_name = 
  open ProtoGraphics in
  let data = Std.input_file ~bin:True file_name in
  let buf = new BinaryBuffer.input data in
  let resource = Resource.read_resource buf in
  let (itype,images) = 
    match resource.Resource.resource_data with
    [ `Tile x -> (`Tile,[x])
    | `Decor x ->  (`Object,[x.Lhg.decor_img])
    | `House x ->  (`Object,[x.Lhg.house_bottom_img;x.Lhg.house_top_img])
    | _ -> failwith "unknown locitem resource"
    ] 
  in
  ( itype, List.map (fun img -> (img.Base.hot_x, img.Base.hot_y, Sdlloader.load_image_from_mem img.Base.img)) images);


value do_scroll ch_x ch_y = 
  let (o_x,o_y) = scroll_offset.val in
  let new_x = (o_x+ch_x) in
  let new_y = (o_y+ch_y) in
  (
    scroll_offset.val := 
      (if new_x < min_s_x then min_s_x else if new_x > max_s_x then max_s_x else new_x, 
       if new_y < min_s_y then min_s_y else if new_y > max_s_y then max_s_y else new_y);
    render ();
  );

value scroll_data = ref None;

value keyboard_handler e = 
    match e with
    [ Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_ESCAPE} 
    | Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_q}
    | Sdlevent.QUIT -> Evloop.stop ()
    | Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_UP} -> do_scroll 0 20
    | Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_DOWN} -> do_scroll 0 ~-20
    | Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_LEFT} -> do_scroll ~-40 0
    | Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_RIGHT} -> do_scroll 40 0
    | Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_f} ->
        (
          ignore (Sdlwm.toggle_fullscreen ());
          render ();
        )
    | _ -> ()
    ];

value mouse_click_handler e =
    match e with
    [ Sdlevent.MOUSEBUTTONDOWN ev when ev.Sdlevent.mbe_button=Sdlmouse.BUTTON_LEFT ->
       scroll_data.val := Some (ev.Sdlevent.mbe_x,ev.Sdlevent.mbe_y)
    | Sdlevent.MOUSEBUTTONUP ev when ev.Sdlevent.mbe_button=Sdlmouse.BUTTON_LEFT ->
       scroll_data.val := None
    | _ -> ()
    ];


value ui_events_handler _ = (* {{{ *)
  (
   while Sdlevent.has_event () do
     match Sdlevent.poll () with
     [ None -> ()
     | Some e ->
       match e with
       [ Sdlevent.KEYDOWN _
       | Sdlevent.QUIT ->           
           keyboard_handler e
  
       | Sdlevent.MOUSEBUTTONDOWN _
       | Sdlevent.MOUSEBUTTONUP _ -> 
           mouse_click_handler e
  
       | Sdlevent.MOUSEMOTION ev ->
         match scroll_data.val with
         [ None -> ()
         | Some (old_x,old_y) -> 
           (
             do_scroll (old_x - ev.Sdlevent.mme_x) (old_y - ev.Sdlevent.mme_y);
             scroll_data.val := Some (ev.Sdlevent.mme_x,ev.Sdlevent.mme_y);
           )
         ]
       | event ->
           ()
       ]       
     ]
   done;
   render ();
   True;
  ); (* }}} *)


value location_loader p = 
  open ProtoGame.Family_0020.SubFamily_03 in
  open ProtoModel.Location in
  let (tiles,objects) =       
    List.fold_left begin fun (tiles,objects) lii ->  
     let (rtype,img_data) = load_resource (resource_name lii.locitem_id) in
       match rtype with
       [ `Tile -> ([(lii.x,lii.y,lii.level,img_data)::tiles],objects)
       | `Object -> (tiles,[(lii.x,lii.y,lii.level,img_data)::objects])
       ]
    end ([],[]) (List.sort (fun l1 l2 -> compare l2.level l1.level )  p.locitems)
  in
  (             
    Log.d  "LOCATION %d LOADED !!!" p.location.location_id;
    initGround p.location.width p.location.height tiles objects;     
  );

value command_line = Config.arg_options;

value _ =
  (
    Random.self_init();
    Arg.parse command_line (fun _ -> ()) "";
    Config.init ();
    Evloop.init ();

    Sdl.init [`VIDEO];
    at_exit Sdl.quit;

    Sdlttf.init ();
    at_exit Sdlttf.quit;

    (* создаем окно *)
    initScreen ();
    (* обрабатывать события от пользователя каждые 100 милисекунд *)
    ignore(Evloop.make_timer 0.0001 ui_events_handler);

    let authorizer = new CAuth.c (fun host port cookie -> (new CGame.c host port location_loader)#login cookie ) in
      authorizer#login "oleg" "oleg";
    
    Evloop.start ();
  );

